home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / getopt.exe / GETOPT2_.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-08  |  7KB  |  229 lines
  1. {
  2.    Original module in C is
  3.    Copyright (c) 1986,1992 by Borland International Inc.
  4.    All Rights Reserved.
  5.    %% port to BPASCAL and enhancements by Juancarlo Anez
  6.    %% CIS id [73000,1064]
  7.    %% date 92.04.08
  8. }
  9. UNIT GETOPT2_;
  10. INTERFACE
  11.  
  12.   CONST
  13.     MaxArgs   = 50;           { Maximun number of comandline arguments }
  14.     MaxCmdLin = 255;          { Maximun comandline lenth }
  15.     EOFch     = #24;          { returned by getOpt when no more options }
  16.     NONOPTch  = '√';          { returned by getOpt when arg is non-option}
  17.     ERRORch   = #1;
  18.     opterr :Boolean   = FALSE;   { allow error message   }
  19.  
  20.     optind :Integer   = 1;       { index of which argument is next   }
  21.     optarg :pChar     = nil;     { pointer to argument of current option }
  22.     argc :Integer = 0;           { count of non-opt arguments when
  23.                                    getOpt has returned EOFch }
  24.   VAR
  25.     argv :array[0..MaxArgs] of pChar; { non-opt arguments }
  26.  
  27.   TYPE
  28.     tCharSet = set of succ(' ')..#126;
  29.  
  30.   function getopt(argOpts : pChar):Char;
  31.  
  32. {
  33.   Parse the command line options
  34.  
  35.   The original standard option syntax is:
  36.  
  37.     option ::= SW [optLetter]* [argLetter space* argument]
  38.  
  39.   %%% 92.04.08 -- Juancarlo Anez, CIS 73000,1064
  40.   It has been augmented to:
  41.  
  42.     option ::= SW ([optLetter]* [argLetter space* argument])*
  43.  
  44.   In ohter words, options and non-options may be interplaced.
  45.   Additionaly, after getOpt returns EOFch, argv[] will point only to
  46.   non-options and argc will be the exact count of them
  47.   %%%
  48.  
  49.   where
  50.     - SW is either '/' or '-', according to the current setting
  51.       of the MSDOS switchar (int 21h function 37h).
  52.     - there is no space before any optLetter or argLetter.
  53.     - opt/arg letters are alphabetic, not punctuation characters.
  54.     - argLetters, if present, are found in the argOpts set.
  55.     - argument is any white-space delimited string.  Note that it
  56.       can include the SW character.
  57.     - upper and lower case letters are distinct.
  58.  
  59.   There may be multiple option clusters on a command line, each
  60.   beginning with a SW, but all must appear before any non-option
  61.   arguments (arguments not introduced by SW).  Opt/arg letters may
  62.   be repeated: it is up to the caller to decide if that is an error.
  63.  
  64.   The character SW appearing alone as the last argument is an error.
  65.   The lead-in sequence SWSW ("--" or "//") causes itself and all the
  66.   rest of the line to be ignored (allowing non-options which begin
  67.   with the switch char).
  68.  
  69.   The set ArgOpts allows valid arg letters to be recognized.
  70.   Getopt () returns the value of the option character found, or
  71.   EOF if no more options are in the command line.    If option is an
  72.   argLetter then the global optarg is set to point to the argument
  73.   string (having skipped any white-space).
  74.  
  75.   The global optind is initially 1 and is always left as the index
  76.   of the next argument of argv[] which getopt has not taken.  Note
  77.   that if "--" or "//" are used then optind is stepped to the next
  78.   argument before getopt() returns EOF.
  79.  
  80.   If an error occurs, that is an SW char precedes an unknown letter,
  81.   then getopt() will return a '?' character and normally prints an
  82.   error message via perror().  If the global variable opterr is set
  83.   to false (zero) before calling getopt() then the error message is
  84.   not printed.
  85.  
  86.   For example, if the MSDOS switch char is '/' (the MSDOS norm) and
  87.  
  88.     argOpts == 'AFUZ';
  89.  
  90.   then 'P', 'u', 'w', and 'X' are option letters and 'F', 'U', 'Z'
  91.   are followed by arguments.  A valid command line may be:
  92.  
  93.     aCommand  /uPFPi /X /A L someFile
  94.  
  95.   where:
  96.     - 'u' and 'P' will be returned as isolated option letters.
  97.     - 'F' will return with "Pi" as its argument string.
  98.     - 'X' is an isolated option.
  99.     - 'A' will return with "L" as its argument.
  100.     - "someFile" is not an option, and terminates getOpt.  The
  101.       caller may collect remaining arguments using argv pointers.
  102. }
  103.  
  104.  
  105.  
  106. IMPLEMENTATION
  107.   USES
  108.     WINDOS,
  109.     STRINGS;
  110.  
  111.    CONST
  112.      letP :pChar = nil;  { remember next option char's location }
  113.      SW   :Char  =  #0;  { DOS switch character, either '-' or '/' }
  114.    VAR
  115.      cmdlin :array[0..MaxCmdLin] of Char;
  116.  
  117.      { delete an already processed option from argv }
  118.      procedure compressArgs(i :Integer);
  119.        begin
  120.          while i < argc
  121.          do begin
  122.            argv[i] := argv[i+1];
  123.            inc(i)
  124.          end;
  125.          argv[argc] := nil;
  126.          dec(argc)
  127.        end;
  128.  
  129.      { initialization, determine argc and argv
  130.        using the parsing already done by WINDOS unit
  131.      }
  132.      procedure init;
  133.        var
  134.          i :Integer;
  135.          pos :pChar;
  136.          regs :TRegisters;
  137.        begin
  138.           { get SW using dos call 0x37 }
  139.           regs.AX := $3700;
  140.           msDOS(regs);
  141.           SW := Char(regs.DL);
  142.           argc := getArgCount;
  143.           pos := cmdlin;
  144.           for i := 0 to argc
  145.           do begin
  146.             argv[i] := pos;
  147.             getArgStr(pos, i, 512-(pos-cmdlin));
  148.             pos := strEnd(pos);
  149.             inc(pos);
  150.           end;
  151.           pos^ := #0;
  152.           for i := argc+1 to MaxArgs
  153.           do
  154.             argv[i] := nil;
  155.        end;
  156.  
  157.   function getopt(argOpts : pChar):Char;
  158.     label
  159.       gopERROR;
  160.     var
  161.        ch     :array[0..1] of Char;
  162.        optP   :pChar;
  163.     begin
  164.        if (SW = #0)
  165.        then
  166.          init;
  167.  
  168.        ch[0]  := EOFch;
  169.        ch[1] := #0;
  170.        optarg := nil;
  171.        while (optind <= argc)
  172.        do begin
  173.           if (letP = nil) then begin
  174.              letP := argv[optind];
  175.              if (letP = nil) then break;
  176.              if not (letP^ in [SW,'-','/'])then begin
  177.                optArg := letP;
  178.                letP := nil;
  179.                ch[0] := NONOPTch;
  180.                inc(optind);
  181.                break
  182.              end;
  183.              compressArgs(optind);
  184.              inc(letP);
  185.              if letP^ in [SW,'-','/'] then begin
  186.                 letP := nil;
  187.                 optind := argc+1;
  188.                 break;
  189.              end
  190.           end;
  191.           ch[0]  := letP^;
  192.           if ch[0] = #0 then goto gopError;
  193.           optP := strPos(argOpts, ch);
  194.           inc(letP);
  195.           if (optP <> nil)
  196.           then begin
  197.              if (letP^ = #0)
  198.              then begin
  199.                if (optind >= argc) then goto  gopError;
  200.                letP := argv[optind];
  201.                compressArgs(optind)
  202.              end;
  203.              optarg := letP;
  204.              letP   := nil;
  205.           end
  206.           else  begin
  207.              if (letP^ = #0)
  208.              then begin
  209.                 letP := nil
  210.              end;
  211.              optarg := nil;
  212.           end;
  213.           break
  214.        end;
  215.        getopt := ch[0];
  216.        exit;
  217.  
  218.     gopError:
  219.        if (opterr)
  220.        then begin
  221.           writeln(output,'Unknown switch ',SW,ch[0]);
  222.           halt(1)
  223.        end;
  224.        optarg := letP;
  225.        getopt := ERRORch;
  226.        letP := nil;
  227.        exit;
  228.   end;
  229. END.